En aquest treball fem servir les dades German Credit. Aquest joc de dades classifica les persones segons el risc que tenen a l’hora de demanar un crèdit.
En aquest apartat, es fa una primera anàlisi de les dades. Es vol veure com són les dades i entendre-les el millor possible.
A continuació es mostra una taula amb els atributs del conjunt de dades i la seua explicació:
| Atribut | Descripció |
|---|---|
| checking_balance | Estat del compte corrent |
| months_loan_duration | Durada del préstec en mesos |
| credit_history | Informació sobre crèdits anteriors |
| purpose | Propòsit del prèstec |
| amount | Import del crèdit |
| savings_balance | Quantitat de diners al compte d’estalvis |
| employment_length | Temps treballats en anys |
| installment_rate | Taxa de fraccionament en percentatge de la renda disponible |
| personal_status | Estat personal (divorciat, casat, solter) i sexe (masculí, femení) |
| other_debtors | Altres deutors o fiadors |
| residence_history | Des de quan viu en la residència actual |
| property | Informació sobre les pròpietats i bens |
| age | Edat |
| installment_plan | Altres plans de fraccionament |
| housing | Habitatge |
| existing_credits | Nombre de crèdits existents en aquest banc |
| default | Indica l’impagament de crèdits |
| dependents | Nombre de persones obligades a fer el manteniment |
| telephone | Informació de si té el telèfon registrat al banc o no |
| foreign_worker | Informació de si és un treballador estranger |
| job | Informació bàsica del tipus de feina |
Comencem carregant les dades en un Data Frame. A més, també
fem servir la funció attach(...) per a poder accedir als
objectes del Data Frame només escrivint el seu nom:
df <- read.csv("data/credit.csv", header = TRUE, sep = ",")
df_original <- df
attach(df)Donem una ullada a l’estructura de les dades:
str(df)## 'data.frame': 1000 obs. of 21 variables:
## $ checking_balance : chr "< 0 DM" "1 - 200 DM" "unknown" "< 0 DM" ...
## $ months_loan_duration: int 6 48 12 42 24 36 24 36 12 30 ...
## $ credit_history : chr "critical" "repaid" "critical" "repaid" ...
## $ purpose : chr "radio/tv" "radio/tv" "education" "furniture" ...
## $ amount : int 1169 5951 2096 7882 4870 9055 2835 6948 3059 5234 ...
## $ savings_balance : chr "unknown" "< 100 DM" "< 100 DM" "< 100 DM" ...
## $ employment_length : chr "> 7 yrs" "1 - 4 yrs" "4 - 7 yrs" "4 - 7 yrs" ...
## $ installment_rate : int 4 2 2 2 3 2 3 2 2 4 ...
## $ personal_status : chr "single male" "female" "single male" "single male" ...
## $ other_debtors : chr "none" "none" "none" "guarantor" ...
## $ residence_history : int 4 2 3 4 4 4 4 2 4 2 ...
## $ property : chr "real estate" "real estate" "real estate" "building society savings" ...
## $ age : int 67 22 49 45 53 35 53 35 61 28 ...
## $ installment_plan : chr "none" "none" "none" "none" ...
## $ housing : chr "own" "own" "own" "for free" ...
## $ existing_credits : int 2 1 1 1 2 1 1 1 1 2 ...
## $ default : int 1 2 1 1 2 1 1 1 1 2 ...
## $ dependents : int 1 1 2 2 2 2 1 1 1 1 ...
## $ telephone : chr "yes" "none" "none" "none" ...
## $ foreign_worker : chr "yes" "yes" "yes" "yes" ...
## $ job : chr "skilled employee" "skilled employee" "unskilled resident" "skilled employee" ...Veiem que hi ha 1000 registres i 21 variables. Hi ha variables numèriques i categòriques.
Es pot observar que l’atribut personal_status és una
barreja entre la situació familiar (solter, casat, divorciat) i entre el
sexe de la persona (masculí, femení). Decidim crear una nova variable
sex. Sorprèn veure que en el cas que la persona sigui de
sexe femení no es tinguin dades sobre el seu estat familiar, però, en
canvi, si és de sexe masculí sí.
df$sex <- gsub("(single )?(divorced )?(married )?", "", df$personal_status)
unique(df$sex)## [1] "male" "female"Les variables categòriques s’han carregat com a caràcters, però volem
que siguin factors. Això vol dir que cal convertir les
variables amb tipus caràcter a tipus factor. També cal
convertir la variable objectiu default a
factor.
Per fer-ho fem servir la funció fem servir el seguent codi:
# Convertim les variables categòriques a factor
df[sapply(df, is.character)] <- lapply(
df[sapply(df, is.character)],
as.factor
)
# Convertim la variable default a factor
df$default <- cut(df$default, 2, labels = c("No default", "Default"))Un cop hem obtingut les variables amb el tipus que volem, ens
interessa conèixer si contenen molts valors buits. Ho fem amb la següent
comanda que mostra les variables ordenades per la proporció de valors
buits (NA i caràcters buits):
sort(colMeans(is.na(df) | df == ""), decreasing = TRUE)## checking_balance months_loan_duration credit_history
## 0 0 0
## purpose amount savings_balance
## 0 0 0
## employment_length installment_rate personal_status
## 0 0 0
## other_debtors residence_history property
## 0 0 0
## age installment_plan housing
## 0 0 0
## existing_credits default dependents
## 0 0 0
## telephone foreign_worker job
## 0 0 0
## sex
## 0Per sort, cap dels atributs conté registres buits.
Per a conèixer millor les dades, disposem de les eines de visualització.
Primer de tot, carreguem els paquets que farem servir per a generar
les gràfiques. Aquest són ggplot2, ggalt,
ggtext, ggpubr, grid,
gridExtra i C50:
packages <- c("ggplot2", "ggalt", "ggtext", "ggpubr", "grid", "gridExtra")
not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)## [[1]]
## [1] "ggplot2" "stats" "graphics" "grDevices" "utils" "datasets"
## [7] "methods" "base"
##
## [[2]]
## [1] "ggalt" "ggplot2" "stats" "graphics" "grDevices" "utils"
## [7] "datasets" "methods" "base"
##
## [[3]]
## [1] "ggtext" "ggalt" "ggplot2" "stats" "graphics" "grDevices"
## [7] "utils" "datasets" "methods" "base"
##
## [[4]]
## [1] "ggpubr" "ggtext" "ggalt" "ggplot2" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[5]]
## [1] "grid" "ggpubr" "ggtext" "ggalt" "ggplot2" "stats"
## [7] "graphics" "grDevices" "utils" "datasets" "methods" "base"
##
## [[6]]
## [1] "gridExtra" "grid" "ggpubr" "ggtext" "ggalt" "ggplot2"
## [7] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [13] "base"Analitzem les diferents variables del Data Frame, principalment volem conèixer la seua distribució.
Generem histogrames per a veure com estan distribuïdes:
grid.newpage()
plots <- list()
i <- 1
for (attr in colnames(df)) {
plot <- ggplot(df, aes_string(x = attr)) +
geom_histogram(stat = "count") +
labs(title = attr, x = "") +
theme(axis.text.x = element_text(angle = 30, hjust = 1, vjust = 0.5)) +
theme(plot.margin = unit(c(0.25, 0.25, 0.25, 0.25), "cm"))
plots[[i]] <- plot
i <- i + 1
}
grid.arrange(grobs = plots)
El primer que podem observar és que generalment el crèdit es torna (“No default”), tot i això, el nombre d’impagaments (“Default”) és bastant elevat.
També veiem com els motius més habituals a l’hora de demanar un préstec són comprar un cotxe (nou o de segona mà), un televisor o mobles nous.
Es pot veure que la gran majoria de la gent té menys de
100 DM al seu compte d’estalvis. A més no tenen altres
deutors i que acostumen a tenir només un crèdit.
Com és lògic, hi ha poca gent que ha aconseguit un crèdit sense tenir feina. El més comú és haver estat treballant entre 1 i 4 anys. A més, la gent acostuma a ser treballadors amb grans habilitats.
Els homes solters són el perfil que més crèdits demana. Això sembla lògic per què hi ha més homes solters que casats o divorciats. El que sorprén més, és que sent el 50 % de la societat, hi hagi moltes menys dones amb un crèdit.
El més habitual és que les persones visquin en una casa de la seua propietat, a més, molts d’ells porten 4 anys vivint-hi.
Finalment, una variable que ens sorprèn molt és la de
foreign_worker, aquesta indica que quasi tots els
treballadors són estrangers. Això ens indica que, o bé les dades són
incorrectes, o aquest banc només ha proporcionat dades de clients
estrangers.
També podem generar gràfiques Box Plot que ens ajudin a entendre la distribució de les variables numèriques:
boxplot(df$amount)
boxplot(df$age)
boxplot(df$months_loan_duration)
if (!require("dplyr")) {
install.packages("dplyr", repos = "http:/cran.us.r-project.org")
}
library("dplyr")
remove_attr <- c(
"amount",
"age",
"months_loan_duration",
"default"
)
df_delete <- select(df, !all_of(remove_attr))
boxplot(select_if(df_delete, is.numeric))
Les variables numèriques tenen diverses escales, és per això, que no té cap sentit mostrar-les en una sola gràfica.
Veiem que la mediana de l’import del crèdit és de 2.320. La gran majoria d’usuaris en té menys de 3.972, però més de 1.366. I que hi ha alguns casos que n’han demanat més de 10.000, però es poden considerar casos extrems.
Pel que fa a l’edat, veiem que la majoria de persones que han demanat un préstec tenen entre 27 i 42 anys. La mediana de l’edat és de 33 anys. Veiem com hi ha persones que amb més de 60 anys demanen crèdits, però no és gens habitual.
Els crèdits acostumen a durar entre 12 i 24 mesos. La mitjana està en 20 mesos. Però en casos excepcionals, n’hi ha que s’allarguen més de 40 mesos.
Es pot veure com installment_rate i
residence_history tenen una gràfica molt similar, així que
és possible que estiguin relacionades. La mediana se situa a 3, però a
l’histograma veiem que el més usual és tenir una taxa de fraccionament
de 4 i fer 4 anys que es viu a la residència actual.
És estrany veure que el màxim d’anys viscuts en la mateixa casa sigui de 4, però no tenim forma d’esbrinar si es tracta d’un error. Així que assumirem que les dades són correctes.
Veiem com la gent no acostuma a tenir més de 2 crèdits, de fet, el més normal és tenir-ne només 1.
Pel que fa a la variable dependents, aquest tipus de
gràfica no ens aporta gaire, ja que, només conté 1 o 2. Però, veiem que
la majoria de vegades només una persona és l’obligada a fer el
manteniment.
En aquesta secció volem estudiar la correlació que hi ha entre les diferents variables.
Per a fer-ho, fem servir una matriu de correlacions. Aquesta ens indica amb un cercle de color blau si hi ha una forta correlació positiva, i amb un cercle de color vermell ens indica si hi ha una correlació negativa. Si el cercle és petit i de color blanc, llavors vol dir que no hi ha cap mena de correlació entre totes dos variables.
if (!require("corrplot")) {
install.packages("corrplot", repos = "http:/cran.us.r-project.org")
}
library("corrplot")
# visualize correlation matrix
corrplot(cor(select_if(df, is.numeric)))
Veiem que hi ha una correlació positiva entre la quantitat del crèdit i entre la seua duració. És totalment lògic que sigui així, ja que, com més diners demanes, més es tarda a tornar-los.
Pel que fa a la resta de variables numèriques, no s’observa cap altre tipus de correlació.
defaultAra volem estudiar la relació de cada una de les variables respecte a
la nostra variable objectiu default.
Per això, pintem els histogrames però classificades per l’impagament del crèdit. En aquestes gràfiques “No default” és el color negre i “Default” és el color grana:
grid.newpage()
plots <- list()
i <- 1
for (attr in colnames(df)) {
if (attr == "default") next
plot <- ggplot(df, aes_string(x = attr, fill = factor(default))) +
geom_histogram(stat = "count") +
scale_fill_manual(values = c("#030d0b", "#ae4e38")) +
labs(title = attr, x = "") +
theme(axis.text.x = element_text(angle = 30, hjust = 1, vjust = 0.5)) +
theme(plot.margin = unit(c(0.25, 0.25, 0.25, 0.25), "cm"))
plots[[i]] <- plot
i <- i + 1
}
grid.arrange(grobs = plots)
Es pot observar com el nombre d’impagaments és més alt si el motiu de sol·licitar-lo és comprar-se un cotxe nou.
També veiem com la taxa d’impagaments és superior en aquells que fa menys d’un any que treballen respecte dels que en porten més de set.
Per seguir indagant en aquestes dades, podem generar les gràfiques de les taules de contingència. Aquestes ens mostren el percentatge de defaults que hi ha en cada categoria.
Primer hem de crear les taules (s’ha intentat fer tot aquest procés en un loop, però no s’ha aconseguit):
table_D1 <- table(df$checking_balance, df$default)
table_D2 <- table(df$credit_history, df$default)
table_D3 <- table(df$purpose, df$default)
table_D4 <- table(df$amount, df$default)
table_D5 <- table(df$savings_balance, df$default)
table_D6 <- table(df$employment_length, df$default)
table_D7 <- table(df$installment_rate, df$default)
table_D8 <- table(df$personal_status, df$default)
table_D9 <- table(df$other_debtors, df$default)
table_D10 <- table(df$residence_history, df$default)
table_D11 <- table(df$property, df$default)
table_D12 <- table(df$age, df$default)
table_D13 <- table(df$installment_plan, df$default)
table_D14 <- table(df$housing, df$default)
table_D15 <- table(df$existing_credits, df$default)
table_D16 <- table(df$dependents, df$default)
table_D17 <- table(df$telephone, df$default)
table_D18 <- table(df$foreign_worker, df$default)
table_D19 <- table(df$job, df$default)
table_D20 <- table(df$sex, df$default)Ara mostrem les gràfiques:
par(mfrow = c(7, 3))
plot(table_D1, col = c("#030d0b", "#ae4e38"), main = "Checking balance")
plot(table_D2, col = c("#030d0b", "#ae4e38"), main = "Credit history")
plot(table_D3, col = c("#030d0b", "#ae4e38"), main = "Purpose")
plot(table_D4, col = c("#030d0b", "#ae4e38"), main = "Amount")
plot(table_D5, col = c("#030d0b", "#ae4e38"), main = "Savings Balance")
plot(table_D6, col = c("#030d0b", "#ae4e38"), main = "Employement Lenght")
plot(table_D7, col = c("#030d0b", "#ae4e38"), main = "Installment Rate")
plot(table_D8, col = c("#030d0b", "#ae4e38"), main = "Personal Status")
plot(table_D9, col = c("#030d0b", "#ae4e38"), main = "Other Debtors")
plot(table_D10, col = c("#030d0b", "#ae4e38"), main = "Residence History")
plot(table_D11, col = c("#030d0b", "#ae4e38"), main = "Property")
plot(table_D12, col = c("#030d0b", "#ae4e38"), main = "Age")
plot(table_D13, col = c("#030d0b", "#ae4e38"), main = "Installment Plan")
plot(table_D14, col = c("#030d0b", "#ae4e38"), main = "Housing")
plot(table_D15, col = c("#030d0b", "#ae4e38"), main = "Existing Credits")
plot(table_D16, col = c("#030d0b", "#ae4e38"), main = "Dependents")
plot(table_D17, col = c("#030d0b", "#ae4e38"), main = "Telephone")
plot(table_D18, col = c("#030d0b", "#ae4e38"), main = "Foreign worker")
plot(table_D19, col = c("#030d0b", "#ae4e38"), main = "Job")
plot(table_D20, col = c("#030d0b", "#ae4e38"), main = "Sex")
Podem veure que en general no hi ha gaires diferències entre els valors de les variables. Tot i això, se’n poden destacar algunes.
Els treballadors estrangers tenen un percentatge més alt d’impagaments que els treballadors locals.
Es pot afirmar que conèixer el tipus de propietat on viu la persona és important. Sobretot si viu en un real state.
Les persones més grans acostumen a tornar més els crèdits que les persones joves.
Els estalvis i els diners al compte corrent i l’historial de crèdits també demostren grans diferències.
Finalment, basant-nos en l’anàlisi feta fins ara, es pot concloure que les variables que semblen més importants seran:
checking_balancecredit_historypurposesavings_balanceemployement_lengthpropertyageforeign_workerL’objectiu principal d’aquest treball és analitzar les dades utilitzant un arbre de decisió. Per a fer-ho, abans hem de dividir les dades en dos subconjunts. El conjunt d’entrenament i el de prova. El primer ens serveix per a construir el model, i el segon per a comprovar-ne la qualitat.
La quantitat de dades per a cada un dels conjunts pot variar, però s’acostuma a fer servir \(2/3\) per al conjunt d’entrenament i \(1/3\) per al conjunt de proves.
També hem de separar la variable objectiu de la resta. En el nostre
cas, la variable que volem predir és default:
packages <- c("dplyr")
not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)## [[1]]
## [1] "corrplot" "dplyr" "gridExtra" "grid" "ggpubr" "ggtext"
## [7] "ggalt" "ggplot2" "stats" "graphics" "grDevices" "utils"
## [13] "datasets" "methods" "base"y <- df$default
remove_attr <- c("default")
X <- select(df, !all_of(remove_attr))Ara ja podem dividir el dataset:
set.seed(1899)
split_prop <- 3
indexes <- sample(1:nrow(df),
size = floor(((split_prop - 1) / split_prop) * nrow(df))
)
train_X <- X[indexes, ]
train_y <- y[indexes]
test_X <- X[-indexes, ]
test_y <- y[-indexes]Després d’haver creat els conjunts hem de fer una anàlisi de dades mínim per a assegurar-nos de no obtenir classificadors esbiaixats pels valors que conté cada mostra. En aquest cas, verifiquem que la proporció d’impagaments és més o menys constant en els dos conjunts:
summary(train_X)## checking_balance months_loan_duration credit_history
## < 0 DM :187 Min. : 4.00 critical :202
## > 200 DM : 41 1st Qu.:12.00 delayed : 56
## 1 - 200 DM:181 Median :18.00 fully repaid : 29
## unknown :257 Mean :20.81 fully repaid this bank: 34
## 3rd Qu.:24.00 repaid :345
## Max. :72.00
##
## purpose amount savings_balance employment_length
## radio/tv :193 Min. : 250 < 100 DM :400 > 7 yrs :161
## car (new) :156 1st Qu.: 1376 > 1000 DM : 32 0 - 1 yrs :109
## furniture :117 Median : 2324 101 - 500 DM : 69 1 - 4 yrs :228
## car (used): 71 Mean : 3229 501 - 1000 DM: 40 4 - 7 yrs :123
## business : 62 3rd Qu.: 3964 unknown :125 unemployed: 45
## education : 30 Max. :15857
## (Other) : 37
## installment_rate personal_status other_debtors residence_history
## Min. :1.000 divorced male: 36 co-applicant: 25 Min. :1.000
## 1st Qu.:2.000 female :208 guarantor : 40 1st Qu.:2.000
## Median :3.000 married male : 58 none :601 Median :3.000
## Mean :2.953 single male :364 Mean :2.824
## 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :4.000 Max. :4.000
##
## property age installment_plan housing
## building society savings:154 Min. :19.00 bank :102 for free: 73
## other :218 1st Qu.:27.00 none :537 own :475
## real estate :199 Median :33.00 stores: 27 rent :118
## unknown/none : 95 Mean :35.48
## 3rd Qu.:42.00
## Max. :74.00
##
## existing_credits dependents telephone foreign_worker
## Min. :1.000 Min. :1.000 none:406 no : 24
## 1st Qu.:1.000 1st Qu.:1.000 yes :260 yes:642
## Median :1.000 Median :1.000
## Mean :1.407 Mean :1.153
## 3rd Qu.:2.000 3rd Qu.:1.000
## Max. :4.000 Max. :2.000
##
## job sex
## mangement self-employed: 86 female:208
## skilled employee :427 male :458
## unemployed non-resident: 16
## unskilled resident :137
##
##
## summary(train_y)## No default Default
## 465 201summary(test_X)## checking_balance months_loan_duration credit_history
## < 0 DM : 87 Min. : 4.00 critical : 91
## > 200 DM : 22 1st Qu.:12.00 delayed : 32
## 1 - 200 DM: 88 Median :18.00 fully repaid : 11
## unknown :137 Mean :21.08 fully repaid this bank: 15
## 3rd Qu.:24.00 repaid :185
## Max. :60.00
##
## purpose amount savings_balance employment_length
## radio/tv :87 Min. : 276 < 100 DM :203 > 7 yrs : 92
## car (new) :78 1st Qu.: 1348 > 1000 DM : 16 0 - 1 yrs : 63
## furniture :64 Median : 2300 101 - 500 DM : 34 1 - 4 yrs :111
## business :35 Mean : 3356 501 - 1000 DM: 23 4 - 7 yrs : 51
## car (used):32 3rd Qu.: 3986 unknown : 58 unemployed: 17
## education :20 Max. :18424
## (Other) :18
## installment_rate personal_status other_debtors residence_history
## Min. :1.000 divorced male: 14 co-applicant: 16 Min. :1.000
## 1st Qu.:2.000 female :102 guarantor : 12 1st Qu.:2.000
## Median :3.000 married male : 34 none :306 Median :3.000
## Mean :3.012 single male :184 Mean :2.886
## 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :4.000 Max. :4.000
##
## property age installment_plan housing
## building society savings: 78 Min. :20.00 bank : 37 for free: 35
## other :114 1st Qu.:27.00 none :277 own :238
## real estate : 83 Median :32.50 stores: 20 rent : 61
## unknown/none : 59 Mean :35.69
## 3rd Qu.:41.75
## Max. :75.00
##
## existing_credits dependents telephone foreign_worker
## Min. :1.000 Min. :1.000 none:190 no : 13
## 1st Qu.:1.000 1st Qu.:1.000 yes :144 yes:321
## Median :1.000 Median :1.000
## Mean :1.407 Mean :1.159
## 3rd Qu.:2.000 3rd Qu.:1.000
## Max. :4.000 Max. :2.000
##
## job sex
## mangement self-employed: 62 female:102
## skilled employee :203 male :232
## unemployed non-resident: 6
## unskilled resident : 63
##
##
## summary(test_y)## No default Default
## 235 99Veiem que tots dos conjunts són molt similars, així que podem procedir a crear l’arbre de decisió.
En aquest apartat creem un arbre de decisió Quinlan C5.0. És un tipus d’algoritme de classificació que utilitza un arbre de decisió per prendre decisions basades en diferents atributs.
És una implementació d’un arbre de decisió que fa servir una tècnica anomenada “poda C4.5” per millorar la precisió de l’algoritme. Això es fa seleccionant els atributs més informatius per fer les decisions en cada node de l’arbre, en lloc de seleccionar atributs aleatòriament.
En primer lloc, carreguem el paquet C50:
packages <- c("C50")
not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)## [[1]]
## [1] "C50" "corrplot" "dplyr" "gridExtra" "grid" "ggpubr"
## [7] "ggtext" "ggalt" "ggplot2" "stats" "graphics" "grDevices"
## [13] "utils" "datasets" "methods" "base"Ara creem el model utilitzant les dades d’entrenament:
c50_model <- C5.0(train_X, train_y, rules = TRUE)
summary(c50_model)##
## Call:
## C5.0.default(x = train_X, y = train_y, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Wed Dec 28 13:10:52 2022
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 666 cases (22 attributes) from undefined.data
##
## Rules:
##
## Rule 1: (24/2, lift 1.3)
## foreign_worker = no
## -> class No default [0.885]
##
## Rule 2: (642/199, lift 1.0)
## foreign_worker = yes
## -> class No default [0.689]
##
## Rule 3: (14, lift 3.1)
## checking_balance in {< 0 DM, 1 - 200 DM}
## months_loan_duration > 24
## credit_history = repaid
## savings_balance in {< 100 DM, 101 - 500 DM}
## installment_rate > 2
## age > 27
## job in {skilled employee, unskilled resident}
## -> class Default [0.938]
##
## Rule 4: (8, lift 3.0)
## checking_balance in {< 0 DM, 1 - 200 DM}
## credit_history = repaid
## amount > 7824
## other_debtors = none
## -> class Default [0.900]
##
## Rule 5: (7, lift 2.9)
## credit_history = repaid
## amount <= 1386
## savings_balance = < 100 DM
## installment_rate <= 2
## other_debtors = none
## telephone = none
## -> class Default [0.889]
##
## Rule 6: (28/3, lift 2.9)
## checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
## credit_history = repaid
## savings_balance in {< 100 DM, 101 - 500 DM}
## employment_length in {0 - 1 yrs, 1 - 4 yrs, 4 - 7 yrs, unemployed}
## installment_rate > 2
## personal_status = female
## other_debtors = none
## job in {skilled employee, unskilled resident}
## -> class Default [0.867]
##
## Rule 7: (10/1, lift 2.8)
## checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
## credit_history = delayed
## savings_balance = < 100 DM
## installment_rate > 2
## other_debtors = none
## -> class Default [0.833]
##
## Rule 8: (10/1, lift 2.8)
## checking_balance = unknown
## months_loan_duration > 16
## residence_history <= 2
## installment_plan = bank
## -> class Default [0.833]
##
## Rule 9: (3, lift 2.7)
## months_loan_duration > 42
## other_debtors = guarantor
## -> class Default [0.800]
##
## Rule 10: (3, lift 2.7)
## checking_balance = > 200 DM
## age <= 36
## job = unskilled resident
## -> class Default [0.800]
##
## Rule 11: (17/3, lift 2.6)
## checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
## credit_history = fully repaid
## savings_balance in {< 100 DM, 101 - 500 DM}
## installment_plan = none
## -> class Default [0.789]
##
## Rule 12: (20/4, lift 2.6)
## checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
## credit_history = fully repaid this bank
## savings_balance in {< 100 DM, 101 - 500 DM}
## foreign_worker = yes
## -> class Default [0.773]
##
## Rule 13: (2, lift 2.5)
## credit_history = critical
## installment_rate <= 2
## other_debtors = guarantor
## -> class Default [0.750]
##
## Rule 14: (17/5, lift 2.3)
## checking_balance in {< 0 DM, 1 - 200 DM}
## savings_balance in {< 100 DM, 101 - 500 DM}
## installment_rate > 2
## personal_status in {divorced male, married male}
## other_debtors = none
## job in {skilled employee, unskilled resident}
## -> class Default [0.684]
##
## Rule 15: (409/240, lift 1.4)
## checking_balance in {< 0 DM, > 200 DM, 1 - 200 DM}
## -> class Default [0.414]
##
## Default class: No default
##
##
## Evaluation on training data (666 cases):
##
## Rules
## ----------------
## No Errors
##
## 15 103(15.5%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 449 16 (a): class No default
## 87 114 (b): class Default
##
##
## Attribute usage:
##
## 100.00% foreign_worker
## 62.91% checking_balance
## 16.07% savings_balance
## 15.47% credit_history
## 11.11% installment_rate
## 11.11% other_debtors
## 8.71% job
## 6.76% personal_status
## 4.20% employment_length
## 4.05% months_loan_duration
## 4.05% installment_plan
## 2.55% age
## 2.25% amount
## 1.50% residence_history
## 1.05% telephone
##
##
## Time: 0.0 secsFem servir la funció summary(...) perquè ens retorni
informació sobre el model que acabem de crear. Mostra la crida que l’ha
creat, el nombre de registres i atributs que s’han fet servir, les 15
regles que ha generat i fa una petita avaluació del model amb les dades
d’entrenament.
Veiem que s’equivoca en 103 dels 666 casos donats, és a dir, un 15,5 % dels casos. En la matriu es veu com 16 valors reals de “No default” han siguit classificats incorrectament com a “Default” (falsos positius), mentre que en 98 casos de “Default” han sigut incorrectament classificats com a “No default” (falsos negatius).
És possible que estiguem en un cas d’overfitting. Per això, és important avaluar els arbres de decisió fent servir el conjunt de dades de prova i comprovar si l’error que tenim és cert o massa baix.
Ara podem visualitzar el model. Per a fer-ho, hem de treure
l’argument rules:
c50_model <- C5.0(train_X, train_y)
plot(c50_model, gp = gpar(fontsize = 9.5))
Com que és un arbre amb moltes regles, es veu una imatge molt petita, però si hi cliquem amb el botó dret del ratolí i l’obrim en una pestanya nova es pot ampliar.
En aquest apartat s’hi fa una breu explicació de les regles obtingudes i s’estudia la importància de les variables.
Tenim un total de 15 regles. Cada regla mostrada anteriorment amb la
comanda summary consisteix en:
Les primeres regles fan referència a la variable
foreign_worker. Amb una confiança del 0.885 ens diu que si
el treballador no és estranger, llavors paga el deute. En canvi, també
mostra que si el treballador és estranger, amb una confiança de 0.689
també paga el deute. En aquest cas hi hauria un conflicte, així que
s’agafaria la que té més confiança.
Hi ha una altra regla que determina amb una confiança de 0.900 que
diu que si els diners al compte són inferiors a 200 DM i l’historial de
crèdits diu que han sigut repaid i la quantitat del crèdit
és de més de 7824 i no té altres deutors, llavors hi haurà un
impagament.
Hi ha una regla amb molts casos d’entrenament coberts per la regla. Ens diu que si es coneixen els diners que té al compte corrent, llavors es pot afirmar amb una confiança del 0.414 que acabarà en impagament. És la regla amb menys confiança, però és per la que més casos d’entrenament hi passen.
La regla amb més confiança de totes ens diu que si té menys de 200 DM
al compte corrent, la durada del crèdit és de més de 24 mesos,
l’historial de crèdits diu que han sigut repaid, la
quantitat d’estalvis està entre 0 i 500 DM,
l’installment_rate és superior a 2, l’edat és superior a 27
i té feina, però no és autònom, llavors amb una confiança del 0.938
acabarà en impagament.
Com es pot veure, hi ha moltes regles compostes, això es deu a la quantitat de variables del dataset i a la poca relació que tenen entre elles.
Les regles compostes de moltes condicions és possible que estiguin fent overfitting, ja que, en algunes hi ha condicions que sembla que no tinguin gaire sentit. És un dels problemes de no tenir gaires dades. Amb un conjunt de dades amb més registres és possible que no passi tant.
Una altra mètrica que veiem en la sortida de la funció
summary(..) és l’ús o importància dels atributs. Tenim una
funció anomenada C5imp(...) que mostra la importància de
cada atribut segons la mètrica escollida.
Quan s’utilitza la mètrica usage es calcula la
importància a partir del percentatge de mostres del conjunt
d’entrenament que acaben a un node terminal després de la divisió.
D’aquesta manera, tenim que la primera variable en separar el conjunt té
un valor de 100. A partir, d’aquesta, la resta tenen valors més
xics.
imp_usage <- C5imp(c50_model, metric = "usage")
imp_usage## Overall
## checking_balance 100.00
## foreign_worker 61.41
## other_debtors 59.16
## savings_balance 52.10
## credit_history 45.20
## installment_plan 41.74
## job 20.72
## installment_rate 20.57
## amount 19.22
## months_loan_duration 10.66
## personal_status 10.66
## telephone 5.41
## residence_history 4.80
## employment_length 4.50
## dependents 2.85
## age 2.25
## housing 0.60
## purpose 0.00
## property 0.00
## existing_credits 0.00
## sex 0.00En aquest cas podem veure com l’atribut més important és
foreign_worker i el segon és checking_balance.
Hi ha un conjunt de variables que no es fan servir
(purpose, property, housing,
existing_credits, dependents i
sex).
Quan es fa servir la mètrica splits la importància es
calcula a partir del percentatge de separacions associades a cada
variable.
imp_splits <- C5imp(c50_model, metric = "splits")
imp_splits## Overall
## amount 10.000000
## installment_rate 10.000000
## months_loan_duration 10.000000
## savings_balance 10.000000
## age 6.666667
## checking_balance 6.666667
## credit_history 6.666667
## installment_plan 6.666667
## job 6.666667
## dependents 3.333333
## employment_length 3.333333
## foreign_worker 3.333333
## housing 3.333333
## other_debtors 3.333333
## personal_status 3.333333
## residence_history 3.333333
## telephone 3.333333
## purpose 0.000000
## property 0.000000
## existing_credits 0.000000
## sex 0.000000Podem veure diferències respecte de l’anterior mètrica, ja que, ara
veiem com checking_balance és la variable més rellevant,
seguida de credit_history. Per a trobar
foreign_worker ens hem de desplaçar fins a la setena
posició de la llista.
En la següent gràfica podem veure de forma clara la diferència entre alguns d’aquests atributs:
row_names <- sort(rownames(imp_usage))
imp_usage_sort <- imp_usage[order(rownames(imp_usage)), ]
imp_splits_sort <- imp_splits[order(rownames(imp_splits)), ]
df_imp <- data.frame(
attribute = row_names,
usage = imp_usage_sort,
splits = imp_splits_sort
)
str(df_imp)## 'data.frame': 21 obs. of 3 variables:
## $ attribute: chr "age" "amount" "checking_balance" "credit_history" ...
## $ usage : num 2.25 19.22 100 45.2 2.85 ...
## $ splits : num 6.67 10 6.67 6.67 3.33 ...theme_set(theme_classic())
gg <- ggplot(
df_imp,
aes(x = splits, xend = usage, y = reorder(attribute, usage), group = 1)
) +
geom_dumbbell(
color = "#e3e2e1",
colour_x = "#f2911b",
colour_xend = "#4973f2",
size = 1.5,
) +
labs(
x = NULL,
y = NULL,
title = "Gràfica Dumbbell",
subtitle = "Diferència entre la importància dels atributs segons <span style='color: #f2911b;'>Splits</span> vs. <span style='color:#4973f2;'>Usage</span>"
) +
theme_minimal() +
theme(legend.position = "top") +
theme(plot.subtitle = element_markdown()) +
theme(panel.grid.major.x = element_line(size = 0.05))
plot(gg)
Com hem comentat anteriorment, cal comprovar que el model funciona correctament utilitzant les dades que encara no ha vist.
Això ho fem predient la variable default per a cada un
dels registres del conjunt test_X. Després obtenim la
precisió de l’arbre comprovant les prediccions amb els valors reals
test_y:
predicted_model <- predict(c50_model, test_X, type = "class")
precision <- 100 * sum(predicted_model == test_y) / length(predicted_model)
print(sprintf("La precisió de l'arbre és de: %.4f %%", precision))## [1] "La precisió de l'arbre és de: 76.0479 %"Podem fer servir el paquet gmodels per a obtenir més
informació. Primer de tot, l’instal·lem:
packages <- c("gmodels")
not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)## [[1]]
## [1] "gmodels" "C50" "corrplot" "dplyr" "gridExtra" "grid"
## [7] "ggpubr" "ggtext" "ggalt" "ggplot2" "stats" "graphics"
## [13] "grDevices" "utils" "datasets" "methods" "base"Ara cridem a la funció CrossTable(...) per a que mostri
una matriu de confusió:
CrossTable(test_y, predicted_model,
prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
dnn = c("Reality", "Prediction")
)##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 210 | 25 | 235 |
## | 0.629 | 0.075 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 265 | 69 | 334 |
## -------------|------------|------------|------------|
##
## Veiem que el model s’equivoca més amb els casos que realment són “Default”, un 55,6 % els classifica com a “No default”. En canvi, els casos que realment són “No default” els classifica erròniament un 10,6 % dels cops.
La precisió del model es calcula de la següent forma: \[ Precisió = \frac{TP}{TP+FP} \] En aquest cas tenim que \(TP\) és igual al nombre de registres que eren “Default” i s’han predit com a “Default”. És a dir, 44. I \(FP\) és igual al nombre de registres que eren “Default” i s’han predit com a “No default”. És a dir, 25: \[ Precisió = \frac{44}{44+25} = 0,637 \] És a dir, quan prediu un impagament, és correcte un 63,7 % dels cops.
La sensibilitat del model es calcula de la següent forma: \[ Sensibilitat = \frac{TP}{TP+FN} \] En aquest cas tenim que \(FN\) és igual al nombre de registres que eren “No default”, però s’han predit com a “Default”. És a dir, 55: \[ Sensibilitat = \frac{44}{44+55} = 0,444 \] És a dir, identifica correctament el 44,4 % dels impagaments.
Ara podem calcular també la mesura F-measure, que s’obté amb la següent fórmula: \[ F-Measure = 2 \times \frac{Precisió \times Sensibilitat}{Precisió \times Sensibilitat} \] Apliquem la fórmula i ens dona: 0,261. Com que està bastant més a prop del 0 que de l’1 sabem que és un resultat dolent. Aquestà mètrica ens servirà més endavant quan volguem comparar amb nous models.
Gràcies a calcular aquestes mètriques sabem que aquest model no és capaç de determinar quan una persona que demana un crèdit el tornarà o no. A més, quan classifica un impagament no podem estar segurs que ho sigui. En canvi, si li entra una persona que retornarà el crèdit, és capaç d’encertar-ho amb una altra probabilitat.
Evidentment, aquest model no és gens útil per a usar-lo en producció. Un banc que implementi aquesta predicció s’arrisca al fet que no li retornin una gran quantitat de crèdits i, per tant, a perdre molts diners.
Com s’ha explicat en l’apartat anterior, el model actual no és gens bo. Per la qual cosa, ens veiem obligats a buscar alternatives que el millorin.
En aquest apartat es busca millorar el model canviant alguns paràmetres però mantenint l’algorisme Quinlan C5.0.
També es proven altres tipus d’arbres per a veure com es comparen els models obtinguts.
Una forma de millorar el model actual és mitjançant adaptive boosting. Bàsicament, consisteix a agregar les prediccions de múltiples predictors per a aconseguir millors prediccions. En aquest cas, es construeixen diversos arbres de decisió i els arbres decideixen quina és la millor classe per a cada registre.
Per afegir aquesta funcionalitat a l’arbre C5.0 només hem d’utilitzar
el paràmetre trials. Aquest indica el nombre d’arbres
diferents que es generen. D’entrada comencem amb 10 trials,
però es pot anar provant diversos valors:
c50_model_10 <- C5.0(train_X, train_y, trials = 10)
plot(c50_model_10)
Comprovem amb la precisió i F-measure si hem millorat el model:
calculate_f_measure <- function(model, test_X, test_y) {
predicted_model <- predict(model, test_X, type = "class")
precision <- 100 * sum(predicted_model == test_y) / length(predicted_model)
print(sprintf("La precisió de l'arbre és de: %.4f %%", precision))
cross_table <- CrossTable(test_y, predicted_model,
prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
dnn = c("Reality", "Prediction")
)
precisio <- cross_table$prop.col[2, 2]
sensibilitat <- cross_table$prop.row[2, 2]
f_measure <- (precisio * sensibilitat) / (precisio + sensibilitat)
return(f_measure)
}
f_measure <- calculate_f_measure(c50_model_10, test_X, test_y)## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
## print(f_measure)## [1] 0.2588235Veiem com no només no hem millorat, sinó que hem empitjorat. Provem
amb altres valors de trials:
trials_values <- c(5, 20, 30, 50, 60, 75, 85, 100)
for (trial in trials_values) {
model_aux <- C5.0(train_X, train_y, trials = trial)
f_measure <- calculate_f_measure(c50_model_10, test_X, test_y)
print(paste("Trial:", trial, "F-measure:", f_measure))
}## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 5 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 20 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 30 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 50 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 60 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 75 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 85 F-measure: 0.258823529411765"
## [1] "La precisió de l'arbre és de: 75.4491 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 208 | 27 | 235 |
## | 0.623 | 0.081 | |
## -------------|------------|------------|------------|
## Default | 55 | 44 | 99 |
## | 0.165 | 0.132 | |
## -------------|------------|------------|------------|
## Column Total | 263 | 71 | 334 |
## -------------|------------|------------|------------|
##
##
## [1] "Trial: 100 F-measure: 0.258823529411765"Estem obtenint tota l’estona els mateixos resultats. No acabem d’entendre el perquè. Un dels motius podria ser la manca de dades.
Una altra possibilitat pel qual no estem assolint bons resultats pot ser que les dades siguin molt complexes i que el model intenti ajustar-s’hi massa.
Podem provar de treure del conjunt d’entrenament els atributs que en anteriors models hem vist que no tenen gaire importància.
Primer de tot, seleccionem els atributs amb més importància:
usage_threshold <- 10
splits_threshold <- 6
most_imp <- df_imp$attribute[
df_imp$usage > usage_threshold |
df_imp$splits > splits_threshold
]
test_imp_X <- test_X[most_imp]
train_imp_X <- train_X[most_imp]Ara procedim a entrenar el model:
c50_model_imp <- C5.0(train_imp_X, train_y)
plot(c50_model_imp)
Avaluem el model:
f_measure <- calculate_f_measure(c50_model_imp, test_imp_X, test_y)## [1] "La precisió de l'arbre és de: 77.8443 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 218 | 17 | 235 |
## | 0.653 | 0.051 | |
## -------------|------------|------------|------------|
## Default | 57 | 42 | 99 |
## | 0.171 | 0.126 | |
## -------------|------------|------------|------------|
## Column Total | 275 | 59 | 334 |
## -------------|------------|------------|------------|
##
## print(f_measure)## [1] 0.2658228La F-measure és de 0.2658228, així que tenim uns resultats molt similars als anteriors.
Un altre tipus d’algorisme basat en arbres que es pot provar és Random Forest. Aquest es basa en crear molts arbres de decisió diferents i fer-los servir per a prendre decisions en conjunt.
Primer de tot, carreguem el paquet randomForest:
packages <- c("randomForest")
not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)## [[1]]
## [1] "randomForest" "gmodels" "C50" "corrplot" "dplyr"
## [6] "gridExtra" "grid" "ggpubr" "ggtext" "ggalt"
## [11] "ggplot2" "stats" "graphics" "grDevices" "utils"
## [16] "datasets" "methods" "base"A continuació, es pot crear el nou model amb la funció
randomForest:
rf_model <- randomForest(x = train_X, y = train_y, ntree = 10000)Ara avaluem el model fent servir la funció creada anteriorment:
f_measure <- calculate_f_measure(rf_model, test_X, test_y)## [1] "La precisió de l'arbre és de: 79.9401 %"
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 334
##
##
## | Prediction
## Reality | No default | Default | Row Total |
## -------------|------------|------------|------------|
## No default | 227 | 8 | 235 |
## | 0.680 | 0.024 | |
## -------------|------------|------------|------------|
## Default | 59 | 40 | 99 |
## | 0.177 | 0.120 | |
## -------------|------------|------------|------------|
## Column Total | 286 | 48 | 334 |
## -------------|------------|------------|------------|
##
## print(f_measure)## [1] 0.2721088Tot i que ara tenim una F-measure millor (0.2721088), no es pot considerar que els resultats hagin millorat gaire. Però, cal destacar que amb aquest model la precisió, és a dir, la probabilitat que s’hagi predit correctament un impagament és més alta. Concretament és del 83,6 %. Malauradament, la sensibilitat és molt baixa (41,4 %).
En aquesta secció tornem a executar una anàlisi de la influència de les variables, però utilitzant un altre mètode. Ens ha de servir per acabar de conèixer els atributs del conjunt de dades i com es fan servir en els models basats en arbres.
Instal·lem el paquet iml, que ens donarà les mètriques
interpretabilitat:
packages <- c("iml", "patchwork")
not_installed <- packages[!(packages %in% installed.packages())]
if (length(not_installed) > 0) {
install.packages(not_installed, repos = "http:/cran.us.r-project.org")
}
lapply(packages, library, character.only = TRUE)## [[1]]
## [1] "iml" "randomForest" "gmodels" "C50" "corrplot"
## [6] "dplyr" "gridExtra" "grid" "ggpubr" "ggtext"
## [11] "ggalt" "ggplot2" "stats" "graphics" "grDevices"
## [16] "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "patchwork" "iml" "randomForest" "gmodels" "C50"
## [6] "corrplot" "dplyr" "gridExtra" "grid" "ggpubr"
## [11] "ggtext" "ggalt" "ggplot2" "stats" "graphics"
## [16] "grDevices" "utils" "datasets" "methods" "base"Primer, creem un nou model amb Random
Forest. Podem mesurar la rellevància de cada variable amb
la funció FeatureImp(...). La mesura es basa en funcions de
pèrdua de rendiment com “ce”:
rf <- randomForest(default ~ ., data = df_original, ntree = 50)
X <- df_original[which(names(df_original) != "default")]
predictor <- Predictor$new(rf, data = df_original, y = "default")
imp_ce <- FeatureImp$new(predictor, loss = "ce")
plot(imp_ce)
Segons aquest gràfic, les variables més importants són
checking_balance, age i amount. I
les menys rellevants són dependents,
foreign_worker i telephone.
Ara que ja hem arribat al final del treball podem concloure que segurament el conjunt de dades no és prou ampli per a fer-ho servir amb models basats en arbres. Estaria bé tenir més registres que aportessin més varietat a les dades.
Com ja s’ha comentat, és curiós el biaix que hi ha respecte als treballadors estrangers. Estaria bé obtenir més registres de treballadors locals per a estudiar si el comportament és diferent.
També seria important tenir dades sobre l’estat familiar de les dones.
Durant el projecte s’ha vist que les variables més importants són
checking_balance, age, amount,
credit_history i foreign_worker. Moltes
d’elles ja les havíem intuït en l’anàlisi prèvia.
No es pot considerar que cap dels models aconseguits pugui fer-se servir en el món real.
Els arbres de decisió són molt pràctics per què són capaços de predir variables i alhora és fàcil explicar el seu funcionament. Malgrat tot, en aquest cas no la seua senzillesa no ens ha servit.
És possible que amb un tractament diferent de les dades i amb un estudi més extens dels paràmetres de cada algorisme s’hagin pogut assolir millors resultats. Tot i això, no creiem que la diferència sigui molt elevada.